perm filename PAGED.F4[MSS,LCS]3 blob
sn#249531 filedate 1976-11-24 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C THIS AIDS IN EXTRACTING PARTS FROM SCORES. SEE PT1.CMD
C00017 ENDMK
C⊗;
C THIS AIDS IN EXTRACTING PARTS FROM SCORES. SEE PT1.CMD
COMMON/STF/RSTFAC(-3/4),RSTJ2 /POSI/STFF(-3/4),JJ2,JPQ
1 /IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),
1 RCLEF(-3/4) /IVV/NRD(100)
COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
COMMON/XRN/RN(3000) /SF/KL,RT,KP,STFSZ,NAMX
1 /PTR/KWDS(250)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
C INCREASE DIMENSION OF KWDS (KPN & Q) FOR VERY FULL PAGES.
DIMENSION MM(1500),NN(1500),BARS(509),IWDS(1),
1 RSIG(-3/4),RMETER(-3/4),RCL(-3/4)
COMMON /PX/KPN(350) /Q/Q(3500) /KBAR/KBAR(512)
1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
1 /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT,LASTNM
DATA FIB/.7/,RSPC/25./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
1 ,RLTRSZ/1.0/,SPCPG/2.7/
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
1,(MM,RN),(NN,RN(1501)),(KS,RS),(BARS,KBAR(4)),(IWDS,KBAR(4))
1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
C RQ(2) IS R4, RQ(3) IS R5 ETC.
JNM=1
KBR=0
NMPG='PAGEA'
JRD=0
ENDLN=0
SAVSIZ=0
TYPE 3
ACCEPT 2,KS,NTYPE
2 FORMAT(A5,30I)
C TYPE -1 AFTER NAME(I.E.5 SPACES) TO PRINT INST. NAMES AS READ.
CC IPG=NTYPE-1
IPG=0
C TYPE 1 AFTER NAME FOR 'PAGE' LAYOUT
IF(KS.EQ.' ')KS='OLD'
IF(KS.EQ.'OLD')CALL PT2
CP IF(IPG)GO TO 144
KNM(1)=KS
NAMZ=KS
JNM=2
DO 644 K=1,100
C NO EDIT FILE NEEDED FOR PAGE LAYOUT INPUT!!! TYPE 'NAME' 1
644 NRD(K)=1
CP344 KNM(JNM)='ZZZZZ'
CP IF(IPG)GO TO 744
DO 911 K=1,8
RCLEF(K-4)=99
RCL(K-4)=99
RMETER(K)=99
C INITS STUFF FOR PAGE LAYOUT
911 RSIG(K)=99
BRACK=0
744 XSIG=FIB
CLEF=-1
XMTR=FIB
XLFT=0
JPG=0
YCLEF=2.
YSIG=2.
YMTR=2.
RSTAFF=0
RM=0
1344 JNM=1
CC XMTR=FIB
CC XLFT=0
CC JPG=0
CC YCLEF=2.
CC YSIG=2.
CC YMTR=2.
CC RSTAFF=0
CC RM=0
KQ=0
JRD=0
L=1
LK=1
86 FORMAT(1XA5)
3 FORMAT(' TYPE FILE NAME ',$)
83 NAME=KNM(JNM)
JNM=JNM+1
CP IF(NAME.EQ.'ZZZZZ')GO TO 20
JRD=JRD+1
NXX=NRD(JRD)
CC NAMZ=NAME
IF(KBR.EQ.0)GO TO 284
JZ=-1
10 IF(LOOKF(NAME))GO TO 284
IF(JZ)GO TO 344
C FOUND NO MORE TO READ
1212 CALL PUTEXT('BARS','PAG')
CALL EXTOUT(KBAR,512)
RSTJ2=SAVSIZ
CALL EXTOUT(RSTFAC,128)
CALL FINEXT
C K (NUM OF BARS - UP TO 511) IS FIRST LOC OF KBAR.
CALL PT2(KPN,Q,KWDS,RN)
344 NAME=NAMZ+256
NAMZ=NAME
JZ=0
IF(LOOKF(NAME).GE.0)GO TO 10
KNM(1)=NAME
284 JZ=0
SN=0
CP IF(IPG)SN=200
SNMTR=SN
IF(RM.NE.0)GO TO 277
RM=-1
4 FORMAT(' TYPE INST NAME '$)
IF(IPG.EQ.0)GO TO 277
CP TYPE 4
CP ACCEPT 2,RNAM,K
CP RNAM2=0
CP RNAM3=0
CP RNAM4=0
CP IF(K.EQ.0)GO TO 277
CP TYPE 177
CP ACCEPT 2,RNAM2,K
CP IF(K.EQ.0)GO TO 277
C TYPE NUM AFTER NAME TO ENTER UP TO 4 NAMES.
CP TYPE 177
CP ACCEPT 2,RNAM3
CP TYPE 177
CP ACCEPT 2,RNAM4
CP177 FORMAT(' OTHER INST NAME ',$)
277 TYPE 86,NAME
CALL GETEXT(NAME,'DMD')
C LP IS START OF RN ARRAY THIS TIME
CALL EXTIN(RSTFAC,20)
CALL EXTIN(KWDS,JJ2)
CALL EXTIN(RN,JPQ)
IF(SAVSIZ.EQ.0)SAVSIZ=RSTJ2
CP IPG=NTYPE-1
IPG=0
C IPG MUST BE RESET EACH TIME BECAUSE READIN WIPES IT OUT.
CP IF(IPG)GO TO 811
C MUST BE PRE-SORTED FOR PAGE LAYOUT
DO 1711 N=1,JPQ
1711 Q(N)=RN(N)
CC NK=JJ2-1
ITEM=JJ2-2
1211 R=RN(KWDS(1)+3)
K=2
J=0
1111 IF(RN(KWDS(K)+1).GT.2)GO TO 2611
C SORTS NOTES AND RHYTH ONLY
RA=RN(KWDS(K)+3)
IF(RA.GE.R)GO TO 1011
CALL EXCH(KWDS(K),KWDS(K-1))
J=-1
1011 R=RA
2611 K=K+1
IF(K.LE.ITEM)GO TO 1111
IF(J)GO TO 1211
C NOW ALL SORTED
J=1
KW=1
DO 1311 K=1,ITEM
LS=KWDS(K)
IF(RN(LS+1).GT.2)GO TO 2711
RN(LS+3)=RN(LS+3)-.01
C MOVE ALL NOTES AND RESTS SLIGHTLY TO LEFT. (FOR SORTER)
2711 M=RN(LS)+2
DO 1411 N=LS,M+LS
Q(J)=RN(N)
1411 J=J+1
KPN(K)=KW
1311 KW=KW+M+1
KPN(ITEM+1)=KW
CC DO 1511 K=1,ITEM+1
CC1511 KWDS(K)=KPN(K)
CC DO 1611 K=1,JPQ
CC1611 RN(K)=Q(K)
CALL BLTEM
C BLTEM BLTS ARRAYS KPN AND Q INTO KWDS AND RN
811 DO 577 K=1,ITEM
J=KWDS(K)
R=RN(J+1)
CP IF(IPG)GO TO 111
C IPG=-1 = EXTRACTING PARTS, =0 = PAGE LAYOUT.
IF(R.NE.8)GO TO 211
IF(ENDLN.NE.0)GO TO 211
JPG=JPG+1
R5=RN(J+2)
RSTNUM(JPG)=R5
RHGT(JPG)=0
IF(RN(J).GE.2)RHGT(JPG)=RN(J+4)
RPSZ(JPG)=RSTFAC(IFIX(R5))
C***211 RN(J+2)=RN(J+2)*.1
C*** STAFF NUMS WILL NOW BE -.3 UP TO +.4. NO STAFF NAME NEEDED.
IF(R5.EQ.0)SPCNT=SPCPG*RPSZ(JPG)
211 IF(R.NE.4)GO TO 577
IF(RN(J+3).GT.0)GO TO 577
IF(RN(J).GE.5)BRACK=RN(J+7)
C SAVE 'BRACKET' INFO (P7=3,4 OR 5) - CAN FIND WRONG THING!!
GO TO 577
111 IF(R.NE.8)GO TO 677
IF(RN(J).LT.6)GO TO 577
C NO NAME ON THIS STAFF - SO JUMP
IF(RN(J+7).NE.0)GO TO 577
C SKIPS INVISIBLE STAVES.
XLFT=RN(J+3)
C LEFT LIMIT OF STAFF
R9=RN(J+9)
IF(NTYPE)TYPE 86,R9
IF(R9.EQ.RNAM)GO TO 977
IF(RNAM2.EQ.R9)GO TO 977
IF(RNAM3.EQ.R9)GO TO 977
IF(RNAM4.NE.R9)GO TO 577
977 I=RN(J+2)+RSTAFF
SN=I
SNMTR=SN
GO TO 477
677 IF(R.NE.10)GO TO 577
IF(RN(J).LT.4)GO TO 577
IF(RN(J+6).GT.RNUM)GO TO 577
C SKIPS PAGE NUMS. (I.E. BIG SIZE)
CC?? IF(RN(J).GE.6)P=-1
C FOUND A NUM. IN BOX ↑↑, REMEMBER IT DID.
GO TO 577
IF(IPG.EQ.0)GO TO 477
CC79 IF(R.NE.16)GO TO 577
CC?? IF(RN(J+5).GE.100)P=-1
C PICKS UP WORD WITH SZ >100
577 CONTINUE
C DIDN'T FIND USEFUL INFO SO SKIP THIS FILE
477 I=JPQ-2
C READS AND WRITES 1 EXTRA WORD
CP IF(IPG.EQ.0)GO TO 13
CP877 NXX=NXX-1
CP NAME=NAME+2
CP IF(NXX.NE.0)GO TO 277
CP JRD=JRD+1
CP NXX=NRD(JRD)
CP IF(NXX.NE.0)GO TO 44
CP NAME=0
CP NAMZ=0
CC44 KX=1
CP44 RSTAFF=0
CP IWDS(1)=1
13 YN=0
IF(SN.NE.200)GO TO 8
YN=-1
IF(YCLEF.GT.1)YCLEF=-1
IF(YSIG.GT.1)YSIG=-1
IF(YMTR.GT.1)YMTR=-1
8 ZLFT=XLFT+.5
RNUM=PGNUM
C SIZE FACTOR FOR PAGE NUMBER FINDER (MAYBE).
DO 6 K=1,ITEM
R5=-1
J=KWDS(K)
R=RN(J+1)
IF(R.EQ.0)GO TO 6
C DUPLICATE BARS WERE CHANGED TO CODE 0
IF(R.NE.10)GO TO 800
IF(RN(J).LT.4)GO TO 80
IF(RN(J+6).GT.RNUM)GO TO 6
C SKIPS PAGE NUMS. (I.E. BIG SIZE)
IF(RN(J).LT.6)GO TO 80
RN(J+4)=RNMHT
C THE ABOVE SET HEIGHT AND SIZE OF REHEARSAL NUMS.
GO TO 810
800 IF(R.NE.4)GO TO 80
IF(RN(J).NE.2)GO TO 182
C FOUND A BAR LINE
IF(RN(J+3).LT.ZLFT)GO TO 6
C DROPS BAR LINE AT LEFT OF STAFF.
CALL DBAR(K,ITEM,J)
IF(YN.EQ.0)GO TO 810
CALL ADRST(IWDS)
GO TO 6
182 RN(J+1)=44
C CHANGES CODE NUM
A=RN(J)
IF(A.LT.5)GO TO 80
IF(RN(J+7).GE.3)GO TO 6
C SKIP HEAVY BRACKETS.
IF(A.LT.4)GO TO 80
A=RN(J+6)
IF(A.EQ.0)GO TO 80
IF(A.GE.199)RN(J+6)=200
80 IF(R.NE.16)GO TO 180
CP IF(IPG.EQ.0)GO TO 180
CP IF(RN(J+5).GE.100)RN(J+2)=SN
C CATCHES WANTED TEXT ON OTHER LINES. (P5>100)
CP IF(RN(J+5).GT.RLTRSZ)RN(J+5)=RLTRSZ
C LIMITS SIZE OF LETTERS. ADJUST RLTRSZ TO SUIT. (SET AT 1.0 NOW)
180 RSN=RN(J+2)
CP IF(IPG)GO TO 2011
ISN=RSN
RSN=SN
C THE STAFF NUM.
2011 IF(R.NE.3)GO TO 3801
CP IF(IPG)GO TO 2111
CLEF=RCL(ISN)
GO TO 4801
2111 IF(YCLEF)GO TO 4801
IF(RSN.NE.SN)GO TO 6
CC4801 RR=AMOD(RN(J+5),100.0)
C ↑↑↑↑↑ BECAUSE SOME CLEFS ARE MINI-CLEFS
CC IF(RN(J).LT.3)RR=0
4801 RR=CLEFN(RN,J)
C FUNCTION CLEFN FINDS CLEFS NUM.
IF(RR.EQ.CLEF)GO TO 6
C SKIP DUPLICATE CLEFS.
IF(RR.GT.3.AND.RR.LT.100)GO TO 4800
CP IF(IPG)GO TO 16
RCL(ISN)=RR
IF(RCLEF(ISN).EQ.99)RCLEF(ISN)=RR
C SAVE FIRST CLEF ON EACH STAFF
GO TO 1800
CP16 FORMAT(' CLEF=',F2.0,' --CHANGE TO--',$)
CP TYPE 16,RR
CP ACCEPT 5,RR
CP17 R5=RR
CP CLEF=RR
CP YCLEF=0
CP GO TO 1800
4800 IF(RSN.NE.SN)GO TO 6
RN(J+1)=33
GO TO 1800
4802 YCLEF=0
C CATCHES CLEF AFTER FIRST RESTS.
GO TO 6
3801 IF(R.NE.17)GO TO 3800
CP IF(IPG)GO TO 2211
XSIG=RSIG(ISN)
GO TO 3802
2211 IF(YSIG)GO TO 3802
IF(RSN.NE.SN)GO TO 6
3802 RR=RN(J+5)
IF(RR.EQ.XSIG)GO TO 6
YSIG=0
XSIG=RR
C SKIPS DUPL. KEY SIGS.
IF(IPG.EQ.0)RSIG(ISN)=RR
GO TO 1800
3800 IF(R.EQ.8)GO TO 6
C OMIT ALL STAVES FOR NOW
IF(R.NE.18.)GO TO 81
CP IF(IPG)GO TO 2311
XMTR=RMETER(ISN)
GO TO 1801
2311 IF(YMTR)GO TO 1801
IF(SNMTR.EQ.200.)SNMTR=RSN
C SO IT WON'T REPEAT METERS.
C CHECK ALL METERS IF LINE HAS NOT THIS INST.
IF(RSN.NE.SNMTR)GO TO 6
1801 RA=RN(J+5)*100.+RN(J+6)
C THE TIME SIG.
IF(XMTR.EQ.RA)GO TO 6
XMTR=RA
YMTR=0
IF(IPG.EQ.0)RMETER(ISN)=RA
GO TO 1800
81 IF(RSN.NE.SN)GO TO 6
CX1800 IF(RN(J+3).LT.XLFT)GO TO 6
C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
1800 IF(R.NE.7)GO TO 282
A=RN(J)
IF(A.LT.5)GO TO 810
A=ABS(RN(J+7))
IF(A.LT.2.OR.A.GT.7)GO TO 82
C CATCHES TRILL WIGGLE OVER END OF LINE.
282 IF(R.NE.5)GO TO 810
C NEXT CHECKS FOR SLUR OVER END OF LINE
82 IF(RN(J+6).GE.199.)RN(J+6)=200.
C ****** 200.0 ABOVE IS SUBJECT TO CHANGE!
810 KL=0
IF(R.GT.2)GO TO 1810
C NEXTS FINDS NOTES AND RESTS WITHOUT RHYTHM (P7 OR P9)
IF(RN(J+3)-PQ.GT.SPCPG)GO TO 1810
C JUMP IF NOT IN SAME VERT. POS.
IF(RT.NE.R)GO TO 1810
C JUMP IF PREVIOUS ITEM WASN'T THE SAME
RS=9-R*2
IF(RN(J).GE.RS)GO TO 1810
C JUMP IF WDCNT IS BIG ENOUGH
KL=RS-RN(J)
C SEND THE DIFFERENCE TO THE SUBROUTINE AND ADD A RHYTHM (1.0)
1810 CALL QRN(J,KPN,K)
C PUTS NEEDED THINGS INTO Q ARRAY
RT=R
PQ=RN(J+3)
C SAVE THINGS FOR NEXT TIME AROUND LOOP.
6 CONTINUE
C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
CALL SORT(KPN)
C SORTS Q ARRAY, PUTS IT BACK INTO RN
23 LL=0
C TO 'MOVE' INSTEAD OF 'JUSTIFY'
J=1
223 K=KWDS(J)
R=RN(K+1)
IF(R.LE.3.OR.R.EQ.17.OR.R.EQ.18)GO TO 123
J=J+1
GO TO 223
123 R8=ENDLN-RN(K+3)+2
CC IF(ENDLN.EQ.0)R8=1.-RN(4)
R4=0
R7=0
RS=0
R9=0
R5=10000
C INSERT?? →→ IF(R8.GT.0)R9=200.
33 CALL PTMOVE(RN,KWDS)
C******* IS KQ SUPPOSED TO BE 0!!!!!!!!?????
CALL SHFT0(KQ)
CCC ENDLN=ENDLN+200-XLFT
CP IF(IPG)GO TO 10
20 CALL RESPC
GO TO 1344
END